Soundex is a phonetic algorithm for indexing names by sound. The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling. This article is about to implement fuzzy logic, that finding names that sound alike. In this article we are creating soundex function that will find the similar kind of words. MS access doesn’t have inbuilt function for soundex functionality but we can create own soundex function using VBA code. This function change the text value to a code combination.

Soundex takes the word and converts it to a 4 character string representation. The first letter will stay the same and then the other 3 letters represent the word without vowels. Soundex code is the first letter, followed by three numbers from assessment of the remaining letters. Vowels and Y,H,W are ignored. When consecutive letters return the same numerical code, the number appears only once. When two cards with the same code are separated only by H or W, the second letter is ignored. The letters are converted to numbers. If the final code after examining all letters is less than three digits, the code is padded with zeros.

To implement this need to create table, query ,Form and module. Table contains the data that we are find on the form and in query sql view we have to write similar query like:

SELECT tblPeople.PersonID, tblPeople.LastName, fSoundex([LastName]) AS Soundex, tblPeople.FirstName, tblPeople.MiddleName FROM tblPeople ORDER BY tblPeople.LastName;

After this we have create soundex function and call this function in after update event of search text box. After this we have to test this function , type word in search box and you will see in bellow list box all the similar sound like words are listing as shown in fig 1.1.

VBA code on text box after_update event:

Option Compare Database
Option Explicit
Private Sub txtLastName_AfterUpdate()
On Error GoTo ErrorHandler
Dim txtSearchString As Variant
Dim strSQL As String
txtSearchString = Me![txtLastName]
If Len(Me![txtLastName] & vbNullString) > 0 Then
strSQL = "SELECT DISTINCTROW PersonID, LastName, FirstName, MiddleName FROM qryPeople WHERE Soundex = '" & fun_Soundex(txtSearchString) & "' ORDER BY LastName, FirstName"
Else
strSQL = "SELECT PersonID, LastName, FirstName, MiddleName FROM qryPeople WHERE LastName) Is Not Null ORDER BY LastName, FirstName"
End If
Me!lstResults.RowSource = strSQL
Me!txtLastName.SetFocus
Cleanup:
Exit Sub
ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
Resume Cleanup
End Sub

VBA code for Soundex function:

Option Compare Database
Option Explicit
Function fun_Soundex(ByVal StringValue As String) As String
On Error GoTo ErrorHandler
Dim sCurrVal As String
Dim sInp As String
Dim sPrev As String
Dim sSndx As String
Dim sIdx As Long
Dim Linp As Long
Dim sCurrChar As String
sInp = UCase$(StringValue)
Linp = Len(sInp)
sSndx = Left(sInp, 1)
sIdx = 1
Do While Len(sSndx) < 4
If sIdx > Linp Then
sCurrVal = "0"
sSndx = sSndx & sCurrVal
Else
sCurrChar = Mid$(sInp, sIdx, 1)
Select Case sCurrChar
Case "B", "F", "P", "V"
sCurrVal = "1"
Case "C", "G", "J", "K", "Q", "S", "X", "Z"
sCurrVal = "2"
Case "D", "T"
sCurrVal = "3"
Case "L"
sCurrVal = "4"
Case "M", "N"
sCurrVal = "5"
Case "R"
sCurrVal = "6"
Case Else 'A, E, I, O, U, H, W, Y or other
sCurrVal = "0"
End Select
End If
If (sCurrVal <> "0") Then
If (sCurrVal <> sPrev) Then
If sIdx <> 1 Then
sSndx = sSndx & sCurrVal
End If
End If
End If
If sCurrChar <> "H" And sCurrChar <> "W" Then
sPrev = sCurrVal
End If
sIdx = sIdx + 1
Loop
Cleanup:
fun_Soundex = sSndx
Exit Function
ErrorHandler:
Err.Raise Err.Number, "fun_Soundex", Err.Description
Resume Cleanup
End Function